home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / batchut / rap101.zip / COMMON.SRC < prev    next >
Encoding:
Text File  |  1989-05-10  |  37.1 KB  |  1,494 lines

  1. ; COMMON.RAP -- standard interaction routines for RAP
  2. ;               copyright 1988 SIL
  3. ;
  4. ;       Gary F. Simons, SIL / Kirk Parker, SIL
  5. ;
  6. ;        Version 1.01 - 10 May 1989
  7. ;                     a. #filesize now reports in Kbytes
  8. ;                     b. *get_input_file now detects non-existent files
  9. ;       Version 1.0  - Released 10 Oct 1988
  10. ;       previously major version:  23 September 1988  khp    for RAP 0.88
  11. ;
  12. ;----------------------------------------------------------
  13. ;
  14. ; This file contains loose code, which enables it to declare some
  15. ; "truly" global variables and to execute some start-up code.
  16. ; As a result, this file is sensitive to the order in which it is loaded:
  17. ;
  18. ;   1. COMMON.RAP must be .included before all other program files that
  19. ;      contain subroutines.  It is still possible to include other files
  20. ;      ahead of COMMON.RAP as long as those files contain only loose code
  21. ;      and/or .define statements.
  22. ;
  23. ;   2. No file loaded after COMMON.RAP may contain loose code.
  24. ;
  25. ; While this will restrict the use of loose code by user programs, the
  26. ; benefits of using the subroutine library far outweigh this minor drawback.
  27. ; Note that using a main subroutine results in a better-documented program
  28. ; anyway!
  29.  
  30. .define .LOCALMATCH declare $left,$match,$right
  31. .define .BELL t:*chr(7)\
  32. .define .YES 1
  33. .define .NO 0
  34.  
  35. ; return values from *existf:
  36.  
  37. .define .NOTFOUND 0
  38. .define .READWRITE 2
  39. .define .READONLY 4
  40.  
  41. .define .MININT (-2147483639)
  42. .define .MAXINT   2147483639
  43.  
  44. ; longest allowed slashcode:
  45.  
  46. .define .MAXCODE 78
  47.  
  48. ; valid filename chars:
  49.  
  50. .define .FILECHARS a-z0-9_A-Z!@#$%^&()'`{}~\-
  51.  
  52. ; 0 - (amount of extra space desired) for ensure_space
  53.  
  54. .define .HEADROOM -10240
  55.  
  56. ;----------------------------------------------------------
  57. ; the following variables must be declared at the global level
  58. ; this group is documented as accessible to the user:
  59.  
  60. #verbose=1                            ; are explanations enabled? default = yes
  61.  
  62. if ($screentype == "Sharp LCD")        ; inter-line spacing for query routines
  63.     $skip=$null
  64. else
  65.     $skip=$newline*chr(13)
  66. endif
  67.  
  68. $valdr=*getdr__()                    ; list of valid disk drives
  69.  
  70. ; this group is non-documented and for internal use only
  71.  
  72. #help__= -1           ; help-file descriptor.  default = help file not opened
  73.                     ; help file name for closing/reopening (default = none)
  74. $helpfile__=
  75. $dospath__=$path    ; save original PATH so we can access it from library
  76.                     ; routines even if caller changes $path
  77.  
  78. ;------------------------------------------------------------
  79. ; error
  80. ;
  81. ;  effect: Sound the alarm and display an error message.  If help
  82. ;          is available, tell the user about it.
  83. ;
  84. ;  inputs: $message  the message to display
  85. ;          $topic    the help topic pertinent to the question that
  86. ;                    was answered incorrectly
  87. ;
  88.  
  89. proc error($message,$topic)
  90.  
  91. declare $tag,$indent
  92. .LOCALMATCH
  93.  
  94. ; add a period to message if needed
  95. if (not ($message contains "[.!?]$"))
  96.     $message=$message.
  97. endif
  98.  
  99. if ($message contains "^[ \\t][ \\t]*")    ; we want the side effect only
  100.     $indent=$match
  101. endif
  102.  
  103. t:$skip*chr(7)$message\
  104.  
  105. if ($topic == "")
  106.     $tag=Try again.
  107. else
  108.     $tag=Try again.  (Type ? for help.)
  109. endif
  110.  
  111. ; terminate line if tag won't fit, indent next line same as message
  112.  
  113. if ((*strlen($message) + *strlen($tag)) > 72)
  114.     t:
  115.     t:$indent\
  116. else
  117.     t:  \
  118. endif
  119.  
  120. t:$tag
  121.  
  122. endproc
  123.  
  124. ; ----------------------------------------------------------
  125. ; warning
  126. ;
  127. ;   effect: Ring alarm and display message.  wait until user enters RETURN
  128. ;
  129.  
  130. proc warning($message)
  131.  
  132. if (not $message has "\\.?!$")
  133.     $message=$message.
  134. endif
  135.  
  136. t:$skip*chr(7)$message.
  137.  
  138. kbflush()
  139. foot
  140.  
  141. endproc
  142.  
  143. ;------------------------------------------------------------
  144. ; mount
  145. ;
  146. ; effect:  Ensure that the needed disk volume is mounted by waiting
  147. ;          for it to be mounted if it is not mounted already.
  148. ;
  149. ; inputs:  $drive  The one-letter designator of the drive
  150. ;          $id     The volume id of the disk that needs to be mounted
  151. ;          $name   The diskette name to be used in a prompt if the
  152. ;                     volume is not already mounted
  153. ;
  154.  
  155. proc mount_volume($drive,$id,$name,$topic)
  156.  
  157. declare $volname,#fd,#case,#opentest,#reopen_help
  158.  
  159. loop
  160.  
  161.     $volname=*volume($drive)
  162.     exit if ($volname == $id)
  163.  
  164.     ; ensure that there are no open files.  It's not safe to change the disk
  165.     ; if there's any chance of an open output file.
  166.  
  167.     if (not #opentest)      ; if we haven't already tested for open files
  168.         #opentest = 1
  169.         #fd = *open("nul")
  170.         close #fd
  171.  
  172.         if (#fd > 1 or (#fd > 0 and #help__ == -1))
  173.             t:*chr(7)
  174.             t:The program needs to change disks so that the $name
  175.             t:disk is accessible, but it is not safe to do so because the program has
  176.             t:one or more files open.
  177.             t:
  178.     
  179.             if ($topic <> "")
  180.                 explain($topic)
  181.             else
  182.                 t:   The program must terminate immediately.  Please report this
  183.                 t:   message to the program's author.
  184.             endif
  185.             foot
  186.             bye
  187.         endif
  188.     endif
  189.     if (#help__ >= 0)
  190.         close #help__
  191.         #help__ = -1
  192.         #reopen_help = 1
  193.     endif
  194.  
  195.     t:$skip\Put the $name disk in drive $drive.
  196.     kbflush()
  197.     foot:Press RETURN after you have done this.
  198.  
  199. endloop
  200.  
  201. if (#reopen_help)
  202.     reopen_help__()
  203. endif
  204.  
  205. endproc
  206.  
  207.  
  208. ; ----------------------------------------------------------
  209. proc panic__($location,$msg)    ; for internal error messages only
  210.  
  211. declare #paged
  212.  
  213. t:*chr(7)$skip\Internal error in \*$location:
  214. t:
  215. t:    $msg
  216. t:
  217. t:The program will continue to run, but the results may not be valid.
  218. t:Copy this message exactly, so you can report it to the program's author,
  219. t:and exit as soon as possible.  You may exit immediately by typing
  220. t:Ctrl-C.
  221. kbflush()
  222. foot
  223. endproc
  224.  
  225. ; ----------------------------------------------------------
  226. proc kbflush()
  227.  
  228. declare $junk
  229.  
  230. loop while (*keypress())
  231.     as $junk
  232. endloop
  233.  
  234. endproc
  235.  
  236. ; ----------------------------------------------------------
  237. ; getdr
  238. ;
  239. ; effect: assemble list of valid drive designators and return as string
  240. ;
  241. ; globals used: $cmdline
  242.  
  243. strfunc getdr__()
  244.  
  245. declare $drvlist,$tmp,#case,#tmp
  246. .LOCALMATCH
  247.  
  248. ; look for /drive=LIST...  on command line
  249.  
  250. if ($cmdline contains "[-/]drive=[ \\t]*")
  251.     $drvlist=$right
  252.     if ($drvlist contains "[ \\t]")
  253.         $drvlist=$left
  254.     endif
  255.     return $drvlist
  256. endif
  257.  
  258. if ($screentype == "Sharp LCD")
  259.  
  260.     if (*freesp("P") == -1)
  261.         return "ABCDG"
  262.     else
  263.         return "ABCDGP"
  264.     endif
  265.  
  266. else        ; it's not a Sharp
  267.  
  268.     $drvlist=AB
  269.     $tmp=C
  270.  
  271.     loop while (*freesp($tmp) > 0)
  272.         $drvlist=$drvlist$tmp
  273.         #tmp = *ascii($tmp) + 1
  274.         $tmp=*chr(#tmp)
  275.     endloop
  276.  
  277.     return $drvlist
  278.  
  279. endif
  280.  
  281. endfunc
  282.  
  283. ;----------------------------------------------------------
  284. ; explain - display help-file information.  *Explain assumes the help-file is
  285. ;           already open with the file descriptor in the global variable
  286. ;           #help.  It also tests the global variable #verbose which is 1 to
  287. ;           enable explanations and 0 to disable.  Note that some routines
  288. ;           (e.g. *get_ans) declare a local copy of #verbose that is set to 1,
  289. ;           thus enabling explanation on a local basis.
  290. ;
  291. ; A help-file has the following format:
  292. ;     \id line
  293. ;     [size line - if this line contains an int, set #fscale to its value]
  294. ;     zero or more index lines in the format topic_name: offset (in bytes)
  295. ;     zero or more topic entries beginning with \text topic_name
  296. ;
  297. ; *explain recognizes the following standard format markers in the help-file:
  298. ;
  299. ;   \text  - beginning of a topic
  300. ;   \cls   - execute a ch: command
  301. ;   \foot  - execute a foot command
  302. ;
  303. ; It may also recognize the following marker(s) in the near future:
  304. ;
  305. ;   \more  - like foot, but allows the user to choose between reading more or
  306. ;            exiting explain (this is similar to the way HELP works in ED.)
  307. ; ----------------------------------------------------------
  308.  
  309. proc explain($topic)
  310.  
  311. declare #case,$line
  312. .LOCALMATCH
  313.  
  314. if (not #verbose)       ; explanations are turned off
  315.     return
  316. else if (#help__ < 0)
  317.     t:There is no help-file available to this program.
  318.     foot                ; ensure the user sees the message
  319.     return
  320. endif
  321.  
  322. seek #help__,2            ; skip \id line
  323.  
  324. ; look for $topic in index - try to match a colon on each line.  If no match,
  325. ;       we're at the end of the index.  otherwise, $left contains the name
  326. ;       and $right contains the index.
  327.  
  328.  
  329. loop while ($line <> "End of file.")
  330.     read #help__,$line
  331.     exit if (not ($line contains ":"))
  332.     exit if ($left == $topic)
  333. endloop
  334.  
  335. if ($line == "End of file." or $left <> $topic)
  336.     t:Sorry, there is no information on <$topic> in the help file.
  337.     foot
  338.     return
  339. endif
  340.  
  341. seek #help__,*value($right),bytes
  342. loop
  343.     read #help__,$line
  344.     exit if ($line == "End of file.")
  345.     if (not ($line has "^\\\\"))        ; no format marker
  346.         t:$line                            ;    so just display the line
  347.     else if ($line=="\\cls")
  348.         cls
  349.     else if ($line=="\\foot")
  350.         foot
  351. ;    else if ($line=="\\more")
  352. ;        exit if (not *more())
  353.     else if ($line has "^\\\\topic[ \\t]")
  354.         exit
  355.     else        ; it's not a marker we recognize - just display it.
  356.         t:$line
  357.     endif
  358. endloop
  359. endproc
  360.  
  361. ; ----------------------------------------------------------
  362. ;
  363. ;get_filespec
  364. ;
  365. ;   changes:  revised to call get_ans
  366. ;             put . in ext
  367. ;
  368. ;effect:  Get a valid drive, subdirectory, name, and extension.
  369. ;           Give help on ? and display directory on dir.
  370. ;
  371. ;inputs:  $query    the query prompt to be displayed
  372. ;         $defpath  default drive and subdirectory
  373. ;         $defname  default file name (without extension)
  374. ;         $defext   default file extension
  375. ;         $topic    help topic
  376. ;
  377. ;returns: valid filespec
  378. ;         parsed filespec in four (global) variables:
  379. ;               $drive, $subdir, $name, $ext
  380. ;
  381.  
  382. strfunc get_filespec($query,$defpath,$defname,$defext,$topic)
  383.  
  384. declare $answer,$left,$match,$right,#case,$default,$defdrive
  385.  
  386. $drive=
  387. $subdir=
  388. $name=
  389. $ext=
  390.  
  391. $defext=*ensure_dot($defext)
  392. if ($defpath <> "")                        ; append \ if default path not blank
  393.     if (not ($defpath has "[:\\\\]$"))    ;     and doesn't end with : or \
  394.         $defpath=$defpath\\        
  395.     endif
  396. endif
  397.  
  398. $default=$defname$defext
  399.  
  400. if ($default <> "")
  401.     $query=$query [$default]
  402. endif
  403.  
  404. loop
  405.     $answer=*get_ans("$query (type DIR for directory):","",$topic,not +
  406.                                                  *strlen($default))
  407.     if (($answer == "") and ($default == $defext))
  408.         error("  Your answer must always include a filename part.",$topic)
  409.         repeat
  410.     else if ($answer == "")
  411.         $answer=$defpath$defname$defext
  412.     else if ($answer contains "^[ \\t]*dir\[ \\t]*")
  413.         show_dir__($right,$defpath,$defext)
  414.         repeat
  415.     endif
  416.  
  417.     if (not ($answer has "[\\\\:]"))        ;add default path if user gave none
  418.         $answer=$defpath$answer
  419.     endif
  420.  
  421.     if (*parse_filespec($answer,.YES,$topic))
  422.         if ($ext == "")
  423.             $ext=$defext
  424.         endif
  425.         return "$drive$subdir$name$ext"
  426.     endif
  427.  
  428. endloop
  429.  
  430. endfunc
  431. ; ----------------------------------------------------------
  432. ;
  433. ;get_input_file
  434. ;
  435. ;  effect: Get the name of an existing file for input.  Give help on ?
  436. ;          and display directory on dir.  Force renaming if the
  437. ;          requested input file has .TMP or .BAK extension.  Also
  438. ;          returns parsed filespec in four global variables listed below.
  439. ;
  440. ;  inputs: $query    the query prompt to be displayed
  441. ;          $defpath  default drive and subdirectory
  442. ;          $defname  default file name (without extension)
  443. ;          $defext   default file extension
  444. ;          $topic    help topic
  445. ;
  446. ; returns: filespec of a file which exists
  447. ;          size (in kilobytes) of the file in global #filesize
  448. ;
  449. ;modifies: Returns parsed filespec in:
  450. ;          $drive, $subdir, $name, $ext
  451. ;
  452.  
  453. strfunc get_input_file($query,$defpath,$defname,$defext,$topic)
  454.  
  455. declare #case,#verbose,$filespec
  456. declare $oldname        ;hold .BAK or .TMP name to be changed
  457.  
  458. #verbose=1     ; ensure that explain() will explain
  459.  
  460. loop
  461.  
  462.     $filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
  463.  
  464.     #filesize=*filesize($filespec)          ;return its size
  465.  
  466.     if (#filesize < 0)
  467.         error("  $filespec does not exist.",$topic)
  468.     else
  469.         #filesize = (#filesize + 1023) / 1024
  470.         if (($ext == ".TMP") or ($ext == ".BAK")) ;rename if TMP or BAK file
  471.             t:*chr(7)An input file may not have a TMP or BAK extension.
  472.             repeat if (*no("Do you want to rename the file to a different+
  473.                 extension","",""))
  474.  
  475.             $oldname=$filespec
  476.             loop
  477.                 $ext=*get_str("New extension for $oldname","","",1,4,.YES)
  478.                 $ext=*ensure_dot($ext)
  479.                 $filespec=$drive$subdir$name$ext
  480.  
  481.                 if (not *val_ext($ext,$topic))
  482.                     repeat
  483.                 else if (($ext == ".TMP") or ($ext == ".BAK"))
  484.                     error("  You must rename the extension to something besides TMP or BAK.",$topic)
  485.                 else if (not *existf($filespec))
  486.                     exit
  487.                 endif
  488.  
  489.                 t:*chr(7)$filespec already exists.  Try a different extension.
  490.             endloop
  491.             xs ren $oldname $name$ext
  492.         endif
  493.  
  494.         return $filespec
  495.     endif
  496. endloop
  497.  
  498. endfunc
  499.  
  500. ; ----------------------------------------------------------
  501. ;
  502. ;get_output_file
  503. ;
  504. ;  effect: Get the name of a valid file for output, verifying overwrite
  505. ;          and ensuring sufficient space remains on device.  Give help
  506. ;          on ? and display directory on dir.  Also returns parsed
  507. ;          filespec in four global variables listed below.
  508. ;
  509. ;  inputs: $query    the query prompt to be displayed
  510. ;          $defpath  default drive and subdirectory
  511. ;          $defname  default file name (without extension)
  512. ;          $defext   default file extension
  513. ;          $topic    help topic
  514. ;          #size     size required (in kilobytes).  0, if no requirement.
  515. ;
  516. ; returns: filespec of a valid file on drive with sufficient space
  517. ;
  518. ;modifies: Returns parsed filespec in:
  519. ;          $drive, $subdir, $name, $ext
  520. ;
  521.  
  522. strfunc get_output_file($query,$defpath,$defname,$defext,$topic,#size)
  523.  
  524. declare $filespec,#case
  525.  
  526. loop
  527.  
  528.     $filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
  529.  
  530.     if (*delq($filespec) <> .READONLY)  ; Verify overwrite if file exists
  531.         ensure_space($drive,$subdir,#size)
  532.         return $filespec
  533.     endif
  534.  
  535. endloop
  536.  
  537. endfunc
  538.  
  539. ;------------------------------------------------------------
  540. ;
  541. ;ensure_space
  542. ;
  543. ;effect:   Ensures that there is adequate space for the estimated
  544. ;          output file size by having user delete files if necessary.
  545. ;
  546. ;inputs:   $drive  The drive on which output file is to be written
  547. ;          $subdir dir path where output file is to be written
  548. ;          #size   The estimated size requirement
  549. ;
  550. ; BUG: note that this subr will allow the user to delete a file which was
  551. ;      previously validated as existing by *get_input_file.
  552.  
  553. proc ensure_space($dr,$subdir,#size)
  554.  
  555. declare #need   ;The number of K we need to reclaim
  556. declare $spare  ;Presentation form of space to spare
  557. declare $delname
  558. declare $path
  559. declare $name,$ext  ; local names to trap global ones used by get_filespec
  560. declare $drive
  561. declare #attr        ; result of trying to delete file
  562.  
  563. if (#size < 1)     ; don't check for space
  564.     return
  565. else if ($dr == "")
  566.     $dr=*currdriv():
  567. else
  568.     $dr=*to_upper("*mid($dr,1,1)"):
  569. endif
  570.  
  571. loop
  572.     #need=#size-(*freesp($dr)/1024)
  573.     exit if (#need < .HEADROOM)    ;we've got enough to spare
  574.  
  575.     if (#need > 0)       ;we have fewer free K than needed
  576.         .BELL
  577.         t:
  578.         t:There is not enough space for the output file on drive $dr.
  579.         t:You need to reclaim at least #need\K of space before proceeding.
  580.  
  581.     else                ;we are borderline -- give user the option
  582.         if (#need == 0)
  583.             $spare=absolutely no space
  584.         else
  585.             #need = (0 - #need)
  586.             $spare=only #need\K
  587.         endif
  588.         .BELL
  589.         t:
  590.         t:Your output file will probably fit on drive $dr, but there is
  591.         t:$spare to spare.  If there is a possibility that the output file
  592.         t:will grow, it would be wise to make some extra space for the +
  593.             output file.
  594.  
  595.         exit if (*no("Do you want to pause to delete some files","y",""))
  596.  
  597.     endif       ;if we fall through here, the user either has to
  598.                 ;or wants to delete some files
  599.  
  600.     xs dir $dr$subdir /w /p
  601.  
  602.     get_filespec("File to delete","$dr$subdir","","","")
  603.  
  604.     if (*to_upper($dr) <> *to_upper($drive))
  605.         error("  You must delete files on drive *to_upper($dr).","")
  606.     else
  607.         $delname=$dr$subdir$name$ext
  608.         #attr = *deletef($delname)
  609.         if (#attr == .NOTFOUND)
  610.             t:File $delname not found.
  611.         else if (#attr == .READONLY)
  612.             t:File $delname is read-only and can't be deleted.
  613.         endif
  614.     endif
  615. endloop
  616.  
  617. endproc
  618.  
  619. ; ----------------------------------------------------------
  620. ;
  621. ;make_tmp_output
  622. ;
  623. ;effect:  Create a .TMP file name based on the filename given as an
  624. ;         input parameter, and insure that there is sufficient
  625. ;         space
  626. ;
  627. ;inputs:  $name    the base filename
  628. ;         #size    size required (in kilobytes).  0, if no requirement.
  629. ;
  630. ;returns: name of corresponding TMP file on a drive with sufficient space
  631. ;
  632. ;assumes: $name does not have TMP extension already.  This is ensured
  633. ;         by always calling get_input_file before this procedure.
  634.  
  635.  
  636. strfunc make_tmp_output($file,#size)
  637.  
  638. declare $left,$right,$match,#case,$path
  639. declare $drive
  640.  
  641. if ($file contains "\\.[^\\.\\\\]*$")
  642.     $file=$left.TMP
  643. else
  644.     $file=$file.TMP
  645. endif
  646.  
  647. if ($file contains ":")
  648.     $drive=$left
  649. else
  650.     $drive=
  651. endif
  652.  
  653. if (*deletef($file) == .READONLY)        ; a .TMP file can be overwritten
  654.                                         ; without asking
  655.     panic__("make_tmp_output","Need to delete $file but it's read-only")
  656. endif
  657.  
  658. ensure_space($drive,"",#size)
  659.  
  660. return $file
  661.  
  662. endfunc
  663.  
  664. ;-----------------------------------------------------------
  665. ;make_bak_file
  666. ;
  667. ;effect:  Renames the $new file to the $old file name, and changes
  668. ;         the $old file to a .BAK file.
  669. ;
  670. ;inputs:  $oldname  The original filespec of the file to be .BAKed
  671. ;         $tmpname  Filespec of the (TMP) file which is to get $oldname
  672. ;
  673. ;assumes: $oldname does not have .BAK extension.  This is ensured by calling
  674. ;         get_input_file originally to get the input filespec.
  675.  
  676.  
  677. proc make_bak_file($oldname,$tmpname)
  678.  
  679. declare $left,$match,$right,#case
  680. declare $bak            ;filespec for BAK file
  681.  
  682. if ($oldname contains "\\.[^\\.\\\\]*$")    ;find the LAST dot on the line
  683.     $bak=$left.BAK
  684. else
  685.     $bak=$oldname.BAK
  686. endif
  687.  
  688. if (*deletef($bak) == .READONLY)
  689.     panic__("make_bak_file","need to delete $bak but it's read-only")
  690. else
  691.     xs ren $oldname *.BAK
  692.     
  693.     if ($oldname contains "[^:\\\\]*$")
  694.         xs ren $tmpname $match
  695.     else
  696.         warning("Couldn't rename $tmpname to $oldname")
  697.     endif
  698. endif
  699.  
  700. endproc
  701.  
  702. ;-----------------------------------------------------------
  703. ;make_bak_to_bat
  704. ;
  705. ;effect:  generate batch file commands to rename $new to $old and
  706. ;          $old to a .BAK file.
  707. ;
  708. ;inputs:  $oldname  The original filespec of the file to be .BAKed
  709. ;         $tmpname  Filespec of the (TMP) file which is to get $oldname
  710. ;
  711. ;assumes: $oldname does not have .BAK extension.  This is ensured by calling
  712. ;         get_input_file originally to get the input filespec.
  713.  
  714.  
  715. proc make_bak_to_bat($oldname,$tmpname,#bat)
  716.  
  717. declare $left,$match,$right,#case
  718. declare $bak            ;filespec for BAK file
  719.  
  720. if ($oldname contains "\\.[^\\.\\\\]*$")    ;find the LAST dot on the line
  721.     $bak=$left.BAK
  722. else
  723.     $bak=$oldname.BAK
  724. endif
  725.  
  726. wr #bat,if exist $bak del $bak
  727. wr #bat,if exist $oldname ren $oldname *.bak
  728. if ($oldname contains "[^:\\\\]*$")
  729.     wr #bat,if exist $tmpname ren $tmpname $match
  730. else
  731.     warning("Couldn't rename $tmpname to $oldname")
  732. endif
  733.  
  734. endproc
  735.  
  736. ; ----------------------------------------------------------
  737. ; prepend dot (if needed) to non-blank file extension
  738.  
  739. strfunc ensure_dot($ext)
  740.  
  741. if ($ext <> "")
  742.     if (*mid($ext,1,1) <> ".")
  743.         $ext=.$ext
  744.     endif
  745. endif
  746.  
  747. return $ext
  748.  
  749. endfunc
  750.  
  751. ; ----------------------------------------------------------
  752. ; val_ext  -  validate filaname extension
  753. ;
  754. ; entry: extension in $file (param)
  755. ;        help-topic in $topic
  756. ;
  757. ; returns: 1 if valid, 0 if invalid
  758. ; displays: error message for invalid conditions
  759.  
  760. numfunc val_ext($ext,$topic)
  761.  
  762. declare $left,$match,$right
  763.  
  764. ; 1: valid ext,  2: dot only (also valid),  3: no dot
  765.  
  766. if ($ext == "")
  767.     return (.YES)
  768. else if ($ext has "^\\.[.FILECHARS]*$")
  769.     if (*strlen($match) > 4)                ; length = 4 to allow for dot
  770.         error("  No more than 3 characters in extension.",$topic)
  771.     else
  772.         return (.YES)
  773.     endif
  774. else
  775.     error("  Extension contains invalid characters",$topic)
  776.     return (.NO)
  777. endif
  778.  
  779. endfunc
  780. ; ----------------------------------------------------------
  781. ; val_dir
  782. ;
  783. ; validate subdirectory name(s)
  784. ;
  785. ; input:    partial path name in $file
  786. ;           help topic in $topic
  787. ;
  788. ; returns:  1 for valid, 0 for invalid
  789. ;
  790. ; displays: appropriate error messages
  791.  
  792. numfunc val_dir($subdir,$topic)
  793.  
  794. .LOCALMATCH
  795.  
  796. if ($subdir == "" or ($subdir contains "^[\\\\\\..FILECHARS][\\\\\\..FILECHARS]*$"))
  797.     return (.YES)
  798. else if (*index($subdir,"/"))
  799.     error("  Path names use \\, not /.",$topic)
  800. else if ($subdir has "[^\\\\\\.]\\." or $subdir has "\\.[^\\\\\\.]" or $subdir has "\\.\\.\\.")
  801.     error("  Dots in subdirectories cannot be mixed with other +
  802.         characters.",$topic)
  803. else 
  804.     error("  Subdirectory name(s) include invalid characters",$topic)
  805. endif
  806. return (.NO)
  807.  
  808. endfunc
  809.  
  810. ; ----------------------------------------------------------
  811. ; val_drive
  812. ;
  813. ; validate drive designator
  814. ;
  815. ; input:    drive in $drive
  816. ;           help topic in $topic
  817. ;
  818. ; returns:  1 if valid, 0 if invalid
  819. ;
  820. ; displays: error messages if needed
  821.  
  822. numfunc val_drive($drive,$topic)
  823.  
  824. declare #case
  825.  
  826. ; match values: 1 = valid letter followed by colon, 2 = any other colon
  827.  
  828. if ($drive has "^[$valdr]:$")
  829.     return .YES
  830. else if ($drive has "^.:$")
  831.     error("  Drive *to_upper($drive) does not exist.",$topic)
  832. else if (*index($drive,":"))
  833.     error("  Cannot use *to_upper($drive) - must be a disk drive",$topic)
  834. else
  835.     error("  Invalid drive designator: $drive",$topic)
  836. endif
  837.  
  838. return (.NO)
  839.  
  840. endfunc
  841.  
  842. ; ----------------------------------------------------------
  843. ; delq
  844. ;
  845. ;   effect: query user before deleting existing file
  846. ;
  847. ;   returns:    .YES     if the file was deleted
  848. ;               .NO      if the file doesn't exist
  849. ;               .INVALID if file is read_only or if user says not to delete
  850. ;
  851. ;   Note that .YES and .NO both mean that the named file no longer exists,
  852. ;   implying a new file of that name can be created.  Normally, the
  853. ;   significant return value from this subr is .INVALID, which indicates the
  854. ;   named file exists, but the user doesn't want to delete/overwrite it, or
  855. ;   that it is a read-only file.
  856.  
  857. numfunc delq($filespec)
  858.  
  859. declare $path,#attrib
  860.  
  861. #attrib = *existf($filespec)
  862.  
  863. if (#attrib == .NOTFOUND)
  864.     return (.NOTFOUND)
  865. else if (#attrib == .READONLY)
  866.     t:*chr(7)$filespec already exists and can't be deleted.
  867.     return (.READONLY)
  868. else
  869.     t:*chr(7)$filespec already exists.  \
  870.     kbflush()
  871.     if (*yes("Do you want to overwrite it","",""))
  872.         killf $filespec
  873.         return (.READWRITE)
  874.     else
  875.         return (.READONLY)
  876.     endif
  877. endif
  878.  
  879. endfunc
  880.  
  881. ; ----------------------------------------------------------
  882. ; delete file if possible, without informing user.  Prevents RAP from
  883. ; trying to delete a read-only or non-existent file (which will halt the
  884. ; current RAP program and return to the RAP immediate mode!)
  885.  
  886. numfunc deletef($file)
  887.  
  888. declare $path,#attr
  889.  
  890. #attr = *existf($file)
  891.  
  892. if (#attr == .READONLY)
  893.     return (.READONLY)
  894. else if (#attr == .READWRITE or #attr == 1)
  895.     killf $file
  896.     return (.READWRITE)
  897. else
  898.     return (.NOTFOUND)
  899. endif
  900. endfunc
  901.  
  902. ;------------------------------------------------------------
  903. ; get_ans
  904. ;
  905. ;  effect: Ask a question, displaying a default response if any,
  906. ;          and return the user's response.  If the user requests
  907. ;          help (by typing ? or help), give help.
  908. ;
  909. ;  inputs: $query    the question to ask
  910. ;          $default  the default response (null if none)
  911. ;          $topic    the help topic (null if none)
  912. ;          #oblig    0 if null response allowed, 1 if not allowed
  913. ;
  914. ;  add maxlen - to allow subr to reserve enough space on-screen.
  915. ;
  916. ; returns: the user's response as a string
  917.  
  918. strfunc get_ans($query,$default,$topic,#oblig)
  919.  
  920. declare $answer, $prompt, #verbose
  921.  
  922. #verbose = 1
  923.  
  924. ; if ((#oblig) and ($default <> ""))
  925. ;         panic__("get_ans","default and obligatory both given")
  926. ; endif
  927.  
  928. if (not ($query has "[?:]$"))
  929.     $query=$query?
  930. endif
  931.  
  932. if ($default <> "")
  933.     $query=$query [$default]
  934. endif
  935.  
  936. loop
  937.     t:$skip$query \
  938.     a:$answer
  939.  
  940.     if ($answer == "")
  941.         if (#oblig and $default == "")
  942.             error("  This question requires an answer.",$topic)
  943.         else
  944.             return $default
  945.         endif
  946.  
  947.     else if ($answer == "?")
  948.         if ($topic <> "")
  949.             explain($topic)
  950.         else
  951.             error("  There is no help for this question.","")
  952.         endif
  953.     else
  954.         return $answer
  955.     endif
  956. endloop
  957.  
  958. endfunc
  959.  
  960. ; ----------------------------------------------------------
  961. ; ask y/n question with default -  return 1 if yes, 0 if no
  962. ;  if $default is "" then force y or n answer
  963. ;  call explanation routine if $topic <> ""
  964.  
  965. numfunc yes($query,$default,$topic)
  966.  
  967. declare $answer,#case
  968.  
  969. loop
  970.     $answer=*get_ans($query,$default,$topic,not *strlen($default))
  971.  
  972.     $answer=*trim($answer)
  973.     if (($answer == "y") or ($answer == "yes"))
  974.         return(1)
  975.     else if (($answer == "n") or ($answer == "no"))
  976.         return(0)
  977.     else
  978.         error("  Please type yes or no.",$topic)
  979.     endif
  980.  
  981. endloop
  982.  
  983. endfunc
  984.  
  985. ; ----------------------------------------------------------
  986. ; ask y/n question, return 1=no, 0=yes, if $default=="", then force y/n
  987. ;   this subr just passes on to *yes and then complements its return
  988.  
  989. numfunc no($query,$default,$topic)
  990.  
  991. return (not *yes($query,$default,$topic))
  992.  
  993. endfunc
  994.  
  995. ; -------------------------------------------------------
  996. ; read string with default, and min and max length limits.
  997. ;   if min limit == 0, then force a non-blank response
  998.  
  999.  
  1000. strfunc get_str($query,$default,$topic,#minlen,#maxlen,#oblig)
  1001.  
  1002. declare $answer,#len
  1003.  
  1004. ; if ((#oblig) and ($default <> ""))
  1005. ;     panic__("get_str","default and obligatory both given")
  1006. ;     #oblig = 0
  1007. ; endif
  1008.  
  1009. if (#minlen > #maxlen)
  1010.     panic__("get_str","minimum length is greater than maximum length")
  1011.     #minlen = 0
  1012. endif
  1013. if (#maxlen < 1)
  1014.     panic__("get_str","maximum length of zero")
  1015.     #maxlen = 78
  1016. endif
  1017.  
  1018. loop
  1019.     $answer=*get_ans($query,$default,$topic,#oblig)
  1020. ;    if ($answer == $default)
  1021. ;        return $answer
  1022. ;    endif
  1023.     #len = *strlen($answer)
  1024.     if (#len < #minlen)
  1025.        error("  Answer too short - must be at least #minlen characters.",$topic)
  1026.     else if (#len > #maxlen)
  1027.        error("  Answer too long - must be #maxlen characters or less.",$topic)
  1028.     else
  1029.         return $answer
  1030.     endif
  1031. endloop
  1032.  
  1033. endfunc
  1034.  
  1035. ; -------------------------------------------------------
  1036. ; get_code
  1037. ;
  1038. ; effect:  Get a slashcode from the user.  Returned value is validated
  1039. ;          as being alphanumeric and not containing the backslash.
  1040. ;          Returns the default value if user hits RETURN.
  1041. ;
  1042. ; inputs:  $query    The prompt query to be displayed
  1043. ;          $default  The default value.  "" if none.
  1044. ;          $topic    Help topic
  1045. ;          #maxlen   maximum number of chars in code
  1046. ;
  1047. ; returns: an alphanumeric string without initial backslash
  1048.  
  1049. strfunc get_code($query,$default,$topic,#minlen,#maxlen)
  1050.  
  1051. declare $answer,$left,$right,$match,#case
  1052.  
  1053. if (#maxlen > .MAXCODE)
  1054.     #maxlen = .MAXCODE
  1055. endif
  1056.  
  1057. if ($default <> "")
  1058.     if ($default contains "^\\\\\\\\*")
  1059.         $default=\\$right
  1060.     else
  1061.         $default=\\$default
  1062.     endif
  1063. endif
  1064.  
  1065. loop
  1066.     $answer=*get_str("$query",$default,$topic,#minlen,#maxlen+1,#minlen)
  1067.     
  1068.     $answer=*trim($answer)
  1069.  
  1070.     if ($answer contains "^\\\\*")
  1071.         $answer=$right
  1072.     endif
  1073.     
  1074.     if (not ($answer has "^[a-z0-9_]*$"))
  1075.         error("  Slash code may contain only letters, digits, and _.",$topic)
  1076.     else if (*strlen($answer) < #minlen)
  1077.         error("  Code is too short - must be at least #minlen characters (not including \\).",$topic)
  1078.     else if (*strlen($answer) > #maxlen)
  1079.         error("  Code is too long - must be no more than #maxlen characters.",$topic)
  1080.     else
  1081.         return $answer
  1082.     endif
  1083. endloop
  1084.  
  1085. endfunc
  1086.  
  1087. ; -------------------------------------------------------
  1088. ; get a numeric answer and force to be within limits
  1089.  
  1090. numfunc get_num($query,$default,$topic,#min,#max)  ; NOTE default is string var!
  1091.  
  1092. declare $string,#number
  1093.  
  1094. if ($default <> "")
  1095.     if (not *isnumber($default))
  1096.         panic__("getnum","default value is not a number")
  1097.         $default=
  1098.     endif
  1099. endif
  1100.  
  1101. if (#min > #max)
  1102.     panic__("getnum","minimum is greater than maximum")
  1103.     #min = .MININT
  1104.     #max = .MAXINT
  1105. endif
  1106.  
  1107. loop
  1108.     $string=*get_ans($query,$default,$topic,not *strlen($default))
  1109.  
  1110.     if (*isnumber($string))
  1111.         #number = *value($string)
  1112.         if ((#number >= #min) and (#number <= #max))
  1113.             return (#number)
  1114.         endif
  1115.     endif
  1116.  
  1117.     error("  Please enter a number between #min and #max.",$topic)
  1118.  
  1119. endloop
  1120.  
  1121. endfunc
  1122.  
  1123. ;------------------------------------------------------------
  1124. ; to_lower
  1125. ;
  1126. ;  effect: Converts all upper case characters in a string to lower case
  1127. ;
  1128. ;  inputs: $source  the string to convert
  1129. ; returns: an equivalent string with upper case changed to lower
  1130. ;
  1131.  
  1132. strfunc to_lower($source)
  1133.  
  1134. .LOCALMATCH
  1135. declare #case
  1136. #case=1         ;use case-sensitive matching
  1137.  
  1138. loop while ($source contains "[A-Z]")
  1139.     $source=$left*chr(*ascii($match)+32)$right
  1140. endloop
  1141.  
  1142. return $source
  1143.  
  1144. endfunc
  1145.  
  1146. ;------------------------------------------------------------
  1147. ; to_upper
  1148. ;
  1149. ;  effect: Converts all lower case characters in a string to upper case
  1150. ;
  1151. ;  inputs: $source  the string to convert
  1152. ; returns: an equivalent string with lower case changed to upper
  1153. ;
  1154.  
  1155. strfunc to_upper($source)
  1156.  
  1157. .LOCALMATCH
  1158. declare #case
  1159. #case=1         ;use case-sensitive matching
  1160.  
  1161. loop while ($source contains "[a-z]")
  1162.     $source=$left*chr(*ascii($match)-32)$right
  1163. endloop
  1164.  
  1165. return $source
  1166.  
  1167. endfunc
  1168.  
  1169. ; ----------------------------------------------------------
  1170. ; trim - strip leading and trailing blanks from arg
  1171.  
  1172. strfunc trim($source)
  1173.  
  1174. declare $left,$match,$right
  1175.  
  1176. if ($source contains "^[ \\t][ \\t]*")     ;trim leading blanks
  1177.     $source=$right
  1178. endif
  1179. if ($source contains "[ \\t][ \\t]*$")        ; trim trailing blanks
  1180.     $source=$left
  1181. endif
  1182.  
  1183. return $source
  1184. endfunc
  1185.  
  1186. ; ----------------------------------------------------------
  1187. proc show_dir__($spec,$defpath,$defext)
  1188.  
  1189. if ($spec <> "")
  1190.     xs dir $spec
  1191. else
  1192.     if ($defext <> "")
  1193.         $defext=*ensure_dot($defext)
  1194.         $defext=*$defext
  1195.     endif
  1196.     if ($defpath <> "")
  1197.         if (not ($defpath has "[:\\\\]$"))
  1198.             $defpath=$defpath\\
  1199.         endif
  1200.     endif
  1201.     xs dir $defpath$defext /w
  1202. endif
  1203. foot
  1204. endproc
  1205.  
  1206. ; ----------------------------------------------------------
  1207. ; parse_filespec
  1208.  
  1209. numfunc parse_filespec($filespec,#report,$topic)
  1210.  
  1211. $drive=
  1212. $subdir=
  1213. $name=
  1214. $ext=
  1215.  
  1216. if ($filespec contains ":")
  1217. ;    if (#report)
  1218. ;        t:parsed drive <$match> from <$right>
  1219. ;    endif
  1220.     $drive=$left:
  1221.     $filespec=$right
  1222.     if (#report)
  1223.         if (not *val_drive($drive,$topic))
  1224.             return (0)
  1225.         endif
  1226.     else if (not ($drive has "^[$valdr]:$))
  1227.         return (0)
  1228.     endif
  1229. endif
  1230.  
  1231. if ($filespec contains "\\.[^\\.\\\\]*$")
  1232. ;    if (#report)
  1233. ;        t:parsed ext <$match> from <$left>
  1234. ;    endif
  1235.     if (*strlen($match) > 4)
  1236.         if (#report)
  1237.             error("  Extension is too long",$topic)
  1238.         endif
  1239.         return (0)
  1240.     else if ($match has "[^\\..FILECHARS]")
  1241.         if (#report)
  1242.             error("  Invalid character(s) in extension.",$topic)
  1243.         endif
  1244.         return (0)
  1245.     endif
  1246.     $ext=$match
  1247.     $filespec=$left
  1248. endif
  1249.  
  1250. if ($filespec has "[^\\\\\\.]\\." or $filespec has "\\.[^\\\\\\.]" or $filespec has "\\.\\.\\.")
  1251.     if (#report)
  1252.         error("  Invalid dots in pathname (only . and .. are valid).",$topic)
  1253.     endif
  1254.     return (0)
  1255. endif
  1256.  
  1257. if ($filespec has "[^.FILECHARS\\.\\\\]")
  1258.     if (#report)
  1259.         error("  Invalid character(s) in subdirectory or filename.",$topic)
  1260.     endif
  1261.     return (0)
  1262. endif
  1263.  
  1264. if ($filespec contains "[^\\\\\\.][^\\\\\\.]*$")
  1265. ;    if (#report)
  1266. ;        t:parsed name <$match> from dir <$left> and extraneous text <$right>
  1267. ;    endif
  1268.     $name=$match
  1269.     $filespec=$left
  1270.     $subdir=$left
  1271. else
  1272.     if (#report)
  1273.         error("  Filename is missing.",$topic)
  1274.     endif
  1275.     return (0)
  1276. endif
  1277.  
  1278. return (1)
  1279.  
  1280. endfunc    
  1281.  
  1282. ; ----------------------------------------------------------
  1283. ; open_help      open help file, saving descriptor and name in "hidden" vars
  1284. ;
  1285. proc open_help($helpfile)
  1286.  
  1287. loop while (not *existf($helpfile))
  1288.     t:*chr(7)The program's help file ($helpfile) cannot be found.  At this point you may:
  1289.     t:
  1290.     menu
  1291.         option enter the correct location (drive and directory) for the help file.
  1292.             $helpfile=*get_str("Help-file location","","",0,64,0)
  1293.         option continue without on-line help available
  1294.             return
  1295.         option quit the program now
  1296.             if (*yes("Are you sure you want to quit","",""))
  1297.                 bye
  1298.             endif
  1299.     endmenu
  1300. endloop
  1301.  
  1302. #help__ = *open($helpfile)
  1303. $helpfile__=*findpath($helpfile)
  1304. return
  1305.  
  1306. endproc    
  1307.  
  1308. ; ----------------------------------------------------------
  1309. ; get_append_file
  1310.  
  1311. strfunc get_append_file($query,$defpath,$defname,$defext,$topic)
  1312.  
  1313. declare #case,#verbose,$filespec,$path
  1314. declare $oldname                ; hold .BAK or .TMP name to be changed
  1315. declare #attrib,#file            ; for creating file if doesn't exist
  1316.  
  1317. #verbose=1     ; ensure that explain() will explain
  1318.  
  1319. loop
  1320.  
  1321.     $filespec=*get_filespec($query,$defpath,$defname,$defext,$topic)
  1322.  
  1323.     #attrib = *existf($filespec)
  1324.  
  1325.     if (#attrib == .READONLY)
  1326.         error("  $name$ext is read-only.  You must use a different file.",$topic)
  1327.         repeat
  1328.     else if (#attrib == .NOTFOUND)
  1329.         #file = *open($filespec,"w")
  1330.         close #file
  1331.     endif
  1332.  
  1333.     #filesize=(*filesize($filespec)+1023)/1024          ;return its size
  1334.  
  1335.     if (($ext <> ".TMP") and ($ext <> ".BAK"))
  1336.         exit
  1337.     else                                    ;rename if TMP or BAK file
  1338.         t:*chr(7)An "append" file may not have a TMP or BAK extension.
  1339.         repeat if (*no("Do you want to rename the file to a different extension","",""))
  1340.  
  1341.         $oldname=$filespec
  1342.         loop
  1343.             $ext=*get_str("New extension for $oldname","","",1,4,.YES)
  1344.             $ext=*ensure_dot($ext)
  1345.             $filespec=$drive$subdir$name$ext
  1346.  
  1347.             if (not *val_ext($ext,$topic))
  1348.                 repeat
  1349.             else if (($ext == ".TMP") or ($ext == ".BAK"))
  1350.                 error("  You must rename the extension to something besides TMP or BAK.",$topic)
  1351.             else if (not *existf($filespec))
  1352.                 exit
  1353.             endif
  1354.  
  1355.             t:*chr(7)$filespec already exists.  Try a different extension.
  1356.         endloop
  1357.         xs ren $oldname $name$ext
  1358.         $filespec=$drive$subdir$name$ext
  1359.         exit
  1360.     endif
  1361. endloop
  1362.  
  1363. return $filespec
  1364.  
  1365. endfunc
  1366.  
  1367. ; ----------------------------------------------------------
  1368. ; get_fixed_output
  1369.  
  1370. strfunc get_fixed_output($filespec,#size,#allow_sub,$query,$topic)
  1371.  
  1372. declare $path
  1373.  
  1374. if (*deletef($filespec) == .READONLY)
  1375.     if (not #allow_sub)
  1376.         t:*chr(7)
  1377.         t:This program needs to create an output file named $filespec,
  1378.         t:but there is an existing file with that name that is read-only.
  1379.         t:
  1380.         if ($topic <> "")
  1381.             explain($topic)
  1382.         else
  1383.             t:You must rename or delete the existing copy of
  1384.             t:$filespec and then rerun this program.
  1385.         endif
  1386.         foot
  1387.         bye
  1388.     else if (not *parse_filespec($filespec,.NO,""))
  1389.         panic__("get_fixed_output","invalid filespec ($filespec)")
  1390.     endif
  1391.     $filespec=*get_output_file($query,"$drive$subdir","",$ext,$topic,#size)
  1392. endif
  1393. return $filespec
  1394.  
  1395. endfunc
  1396.  
  1397. ; ----------------------------------------------------------
  1398. ; mount_program        ensure the named program is accessible via PATH
  1399.  
  1400. proc mount_program($filespec,$topic)
  1401.  
  1402. mount_file__($filespec,.YES,$topic)
  1403.  
  1404. endproc
  1405.  
  1406. ; ----------------------------------------------------------
  1407. ; mount_file__        ensure named file is accessible
  1408.  
  1409. proc mount_file__($filespec,#is_prog,$topic)
  1410.  
  1411. declare $path,#nullfile,#reopen_help,$program
  1412.  
  1413. if (#is_prog)
  1414.     $path=$dospath__
  1415.     $program=program$blank
  1416. endif
  1417.  
  1418. #nullfile = -2
  1419.  
  1420. loop while (not *existf($filespec))
  1421.     t:
  1422.     if (#nullfile < -1)
  1423.         t:*chr(7)\
  1424.         #nullfile = *open("nul")
  1425.         close #nullfile
  1426.  
  1427.         if (#nullfile > 1 or (#nullfile > 0 and #help__ == -1))
  1428.             t:   This program needs to change disks so that the $filespec
  1429.             t:   $program\file is accessible, but it is not safe to do so because
  1430.             t:   one or more files are open.
  1431.             t:
  1432.     
  1433.             if ($topic <> "")
  1434.                 explain($topic)
  1435.             else
  1436.                 t:   The program must terminate immediately.  Please report this
  1437.                 t:   message to the program's author.
  1438.             endif
  1439.             foot
  1440.             bye
  1441.         endif
  1442.     endif
  1443.     t:   This program needs access to the $program\file $filespec.
  1444.     t:   If you can change disks without removing any of your data files, please
  1445.     t:   do so now.  Otherwise, exit by typing Ctrl-C and rearrange your disks
  1446.     t:   so $filespec is available when this program is run.
  1447.     t:
  1448.  
  1449.     if (#help__ >= 0)
  1450.         close #help__
  1451.         #help__ = -1
  1452.         #reopen_help = 1
  1453.     endif
  1454.     kbflush()
  1455.     foot Press ENTER when you have changed disks.
  1456. endloop
  1457.  
  1458. if (#reopen_help)
  1459.     reopen_help__()
  1460. endif
  1461.  
  1462. endproc
  1463.             
  1464. ; ----------------------------------------------------------
  1465. ; mount_file        ensure the named file is accessible in current directory
  1466.  
  1467. proc mount_file($filespec,$topic)
  1468.  
  1469. mount_file__($filespec,.NO,$topic)
  1470.  
  1471. endproc
  1472.  
  1473. ; ------------------------------------------------------------
  1474. ; reopen_help__        reopen help file after disk change
  1475.  
  1476. proc reopen_help__()
  1477.  
  1478. if (*existf($helpfile__))
  1479.     #help__ = *open($helpfile__)
  1480. else
  1481.     t:*chr(7)
  1482.     t:The help-file for this program was on the disk you removed.  You have
  1483.     t:successfully changed disks, and the program should operate properly.
  1484.     t:However, help information will no longer be available when you type '?'.
  1485.     t:
  1486.     $helpfile__=
  1487.     kbflush()
  1488.     foot
  1489. endif
  1490.  
  1491. endproc
  1492.  
  1493.